Verified Commit c852721a authored by Camil Staps's avatar Camil Staps 🚀

Remove Platform dependency from the ABC.Interpreter library (it is still used...

Remove Platform dependency from the ABC.Interpreter library (it is still used for the optimiser and the tests)
parent e5bb8a8c
Pipeline #17541 passed with stages
in 19 minutes and 10 seconds
...@@ -2,8 +2,8 @@ implementation module Compiler ...@@ -2,8 +2,8 @@ implementation module Compiler
import StdFile import StdFile
import StdList import StdList
import StdMaybe
import Data.Maybe
import System.OS import System.OS
import ABC.Interpreter import ABC.Interpreter
...@@ -38,9 +38,9 @@ Start w ...@@ -38,9 +38,9 @@ Start w
where where
program = Add (Lit 1) (Mul (Lit 2) (Add (Lit 3) (Lit 4))) program = Add (Lit 1) (Mul (Lit 2) (Add (Lit 3) (Lit 4)))
testThroughFile :: a !FilePath !*World -> *(a, !*World) testThroughFile :: a !String !*World -> *(a, !*World)
testThroughFile graph fp w testThroughFile graph fp w
# (graph_s,w) = serialize_for_interpretation optimise_addition "compiler.bc" w # (Just graph_s,w) = serialize_for_interpretation optimise_addition "compiler.bc" w
# (ok,f,w) = fopen fp FWriteData w # (ok,f,w) = fopen fp FWriteData w
# (graph_s,f) = graphToFile graph_s f # (graph_s,f) = graphToFile graph_s f
...@@ -50,4 +50,5 @@ testThroughFile graph fp w ...@@ -50,4 +50,5 @@ testThroughFile graph fp w
# (Just graph_s,f) = graphFromFile f # (Just graph_s,f) = graphFromFile f
# (_,w) = fclose f w # (_,w) = fclose f w
= deserialize defaultDeserializationSettings graph_s (IF_WINDOWS "Compiler.exe" "compiler") w # (Just graph,w) = deserialize defaultDeserializationSettings graph_s (IF_WINDOWS "Compiler.exe" "compiler") w
= (graph,w)
definition module ABC.Interpreter definition module ABC.Interpreter
from StdMaybe import :: Maybe from StdMaybe import :: Maybe
from System.FilePath import :: FilePath
:: DeserializationSettings = :: DeserializationSettings =
{ heap_size :: !Int //* Heap size for the interpreter, in bytes { heap_size :: !Int //* Heap size for the interpreter, in bytes
...@@ -12,14 +11,12 @@ defaultDeserializationSettings :: DeserializationSettings ...@@ -12,14 +11,12 @@ defaultDeserializationSettings :: DeserializationSettings
:: *SerializedGraph :: *SerializedGraph
serialize_for_interpretation :: a !FilePath !*World -> *(!SerializedGraph, !*World)
deserialize :: !DeserializationSettings !SerializedGraph !FilePath !*World -> *(a, !*World)
:: InterpretedExpression :: InterpretedExpression
:: *InterpretationEnvironment :: *InterpretationEnvironment
get_start_rule_as_expression :: !DeserializationSettings !FilePath !*World -> *(a, *World) serialize_for_interpretation :: a !String !*World -> *(!Maybe SerializedGraph, !*World)
deserialize :: !DeserializationSettings !SerializedGraph !String !*World -> *(Maybe a, !*World)
get_start_rule_as_expression :: !DeserializationSettings !String !String !*World -> *(Maybe a, !*World)
graphToString :: !*SerializedGraph -> *(!.String, !*SerializedGraph) graphToString :: !*SerializedGraph -> *(!.String, !*SerializedGraph)
graphFromString :: !String -> Maybe *SerializedGraph graphFromString :: !String -> Maybe *SerializedGraph
......
...@@ -9,12 +9,6 @@ import StdMaybe ...@@ -9,12 +9,6 @@ import StdMaybe
import StdMisc import StdMisc
import StdOrdList import StdOrdList
import ArgEnv
import Data.Error
import System.File
import System._Pointer
import graph_copy_with_names import graph_copy_with_names
import symbols_in_program import symbols_in_program
...@@ -46,17 +40,17 @@ defaultDeserializationSettings = ...@@ -46,17 +40,17 @@ defaultDeserializationSettings =
, ie_snodes :: !*{a} , ie_snodes :: !*{a}
} }
serialize_for_interpretation :: a !FilePath !*World -> *(!SerializedGraph, !*World) serialize_for_interpretation :: a !String !*World -> *(!Maybe SerializedGraph, !*World)
serialize_for_interpretation graph bcfile w serialize_for_interpretation graph bcfile w
# (graph,descs,mods) = copy_to_string_with_names graph # (graph,descs,mods) = copy_to_string_with_names graph
# (bytecode,w) = readFile bcfile w # (bytecode,w) = readFile bcfile w
| isError bytecode = abort "Failed to read the bytecode file\n" | isNothing bytecode = (Nothing, w)
# bytecode = fromOk bytecode # bytecode = fromJust bytecode
#! (len,bytecodep) = strip_bytecode bytecode {#symbol_name di mods \\ di <-: descs} #! (len,bytecodep) = strip_bytecode bytecode {#symbol_name di mods \\ di <-: descs}
#! bytecode = derefCharArray bytecodep len #! bytecode = derefCharArray bytecodep len
| free_to_false bytecodep = abort "cannot happen\n" | free_to_false bytecodep = (Nothing, w)
# rec = # rec =
{ graph = graph { graph = graph
...@@ -64,7 +58,7 @@ serialize_for_interpretation graph bcfile w ...@@ -64,7 +58,7 @@ serialize_for_interpretation graph bcfile w
, modules = mods , modules = mods
, bytecode = bytecode , bytecode = bytecode
} }
= (rec, w) = (Just rec, w)
where where
symbol_name :: !DescInfo !{#String} -> String symbol_name :: !DescInfo !{#String} -> String
symbol_name {di_prefix_arity_and_mod,di_name} mod_a symbol_name {di_prefix_arity_and_mod,di_name} mod_a
...@@ -80,12 +74,12 @@ where ...@@ -80,12 +74,12 @@ where
ccall strip_bytecode "sA:VIp" ccall strip_bytecode "sA:VIp"
} }
deserialize :: !DeserializationSettings !SerializedGraph !FilePath !*World -> *(a, !*World) deserialize :: !DeserializationSettings !SerializedGraph !String !*World -> *(Maybe a, !*World)
deserialize dsets {graph,descinfo,modules,bytecode} thisexe w deserialize dsets {graph,descinfo,modules,bytecode} thisexe w
# (host_syms,w) = accFiles (read_symbols thisexe) w # (host_syms,w) = accFiles (read_symbols thisexe) w
# pgm = parse host_syms bytecode # pgm = parse host_syms bytecode
| isNothing pgm = abort "Failed to parse bytecode\n" | isNothing pgm = (Nothing, w)
# pgm = fromJust pgm # pgm = fromJust pgm
# int_syms = {#s \\ s <- getInterpreterSymbols pgm} # int_syms = {#s \\ s <- getInterpreterSymbols pgm}
# int_syms = {#lookup_symbol_value d modules int_syms \\ d <-: descinfo} # int_syms = {#lookup_symbol_value d modules int_syms \\ d <-: descinfo}
...@@ -102,7 +96,7 @@ deserialize dsets {graph,descinfo,modules,bytecode} thisexe w ...@@ -102,7 +96,7 @@ deserialize dsets {graph,descinfo,modules,bytecode} thisexe w
# graph_node = string_to_interpreter int_syms graph ie_settings # graph_node = string_to_interpreter int_syms graph ie_settings
#! (ie,_) = make_finalizer ie_settings #! (ie,_) = make_finalizer ie_settings
# ie = {ie_finalizer=ie, ie_snode_ptr=0, ie_snodes=create_array_ 1} # ie = {ie_finalizer=ie, ie_snode_ptr=0, ie_snodes=create_array_ 1}
= (interpret ie (Finalizer 0 0 graph_node), w) = (Just (interpret ie (Finalizer 0 0 graph_node)), w)
where where
getInterpreterSymbols :: !Pointer -> [Symbol] getInterpreterSymbols :: !Pointer -> [Symbol]
getInterpreterSymbols pgm = takeWhile (\s -> size s.symbol_name <> 0) getInterpreterSymbols pgm = takeWhile (\s -> size s.symbol_name <> 0)
...@@ -156,15 +150,14 @@ where ...@@ -156,15 +150,14 @@ where
where where
PREFIX_D = 4 PREFIX_D = 4
get_start_rule_as_expression :: !DeserializationSettings !FilePath !*World -> *(a, *World) get_start_rule_as_expression :: !DeserializationSettings !String !String !*World -> *(Maybe a, !*World)
get_start_rule_as_expression dsets filename w get_start_rule_as_expression dsets prog filename w
# {[0]=prog} = getCommandLine
# (syms,w) = accFiles (read_symbols prog) w # (syms,w) = accFiles (read_symbols prog) w
# (bc,w) = readFile filename w # (bc,w) = readFile filename w
| isError bc = abort "Failed to read the file\n" | isNothing bc = (Nothing, w)
# bc = fromOk bc # bc = fromJust bc
# pgm = parse syms bc # pgm = parse syms bc
| isNothing pgm = abort "Failed to parse program\n" | isNothing pgm = (Nothing, w)
# pgm = fromJust pgm # pgm = fromJust pgm
# stack = malloc (IF_INT_64_OR_32 8 4 * dsets.stack_size) # stack = malloc (IF_INT_64_OR_32 8 4 * dsets.stack_size)
# asp = stack # asp = stack
...@@ -178,7 +171,7 @@ get_start_rule_as_expression dsets filename w ...@@ -178,7 +171,7 @@ get_start_rule_as_expression dsets filename w
# start_node = build_start_node ie_settings # start_node = build_start_node ie_settings
#! (ie,_) = make_finalizer ie_settings #! (ie,_) = make_finalizer ie_settings
# ie = {ie_finalizer=ie, ie_snode_ptr=0, ie_snodes=create_array_ 1} # ie = {ie_finalizer=ie, ie_snode_ptr=0, ie_snodes=create_array_ 1}
= (interpret ie (Finalizer 0 0 start_node), w) = (Just (interpret ie (Finalizer 0 0 start_node)), w)
// Obviously, this is not a "valid" finalizer in the sense that it can be // Obviously, this is not a "valid" finalizer in the sense that it can be
// called from the garbage collector. But that's okay, because we don't add // called from the garbage collector. But that's okay, because we don't add
// it to the finalizer_list anyway. This is just to ensure that the first // it to the finalizer_list anyway. This is just to ensure that the first
...@@ -351,3 +344,51 @@ malloc :: !Int -> Pointer ...@@ -351,3 +344,51 @@ malloc :: !Int -> Pointer
malloc _ = code { malloc _ = code {
ccall malloc "I:p" ccall malloc "I:p"
} }
readFile :: !String !*World -> (!Maybe String, !*World)
readFile fname w
# (ok,f,w) = fopen fname FReadData w
| not ok = (Nothing, w)
# (ok,f) = fseek f 0 FSeekEnd
| not ok
# (_,w) = fclose f w
= (Nothing, w)
# (size,f) = fposition f
# (ok,f) = fseek f 0 FSeekSet
| not ok
# (_,w) = fclose f w
= (Nothing, w)
# (s,f) = freads f size
# (_,w) = fclose f w
= (Just s,w)
:: Pointer :== Int
derefInt :: !Pointer -> Int
derefInt ptr = code {
load_i 0
}
derefChar :: !Pointer -> Char
derefChar ptr = code inline {
load_ui8 0
}
derefCharArray :: !Pointer !Int -> {#Char}
derefCharArray ptr len = copy 0 (createArray len '\0')
where
copy :: !Int *{#Char} -> *{#Char}
copy i arr
| i == len = arr
# c = derefChar (ptr+i)
= copy (i+1) {arr & [i]=c}
derefString :: !Pointer -> String
derefString ptr
# len = findNull ptr - ptr
= derefCharArray ptr len
where
findNull :: !Pointer -> Pointer
findNull ptr = case derefChar ptr of
'\0' -> ptr
_ -> findNull (ptr+1)
module CodeSharing module CodeSharing
import StdArray import StdEnv
import StdBool import StdMaybe
import StdClass
import StdFile
import StdInt
import StdList
import StdMisc
import StdString
import Data._Array
import Data.Error
from Data.Func import hyperstrict from Data.Func import hyperstrict
import Data.Maybe import System.OS
import System.CommandLine
import System.File
import System.FilePath
import System._Pointer
import Text
import symbols_in_program
import ABC.Interpreter import ABC.Interpreter
import ABC.Interpreter.Util
// Example: get an infinite list of primes from a bytecode file and take only // Example: get an infinite list of primes from a bytecode file and take only
// the first 100 elements. // the first 100 elements.
import StdEnum,StdFunc import StdEnum,StdFunc
//Start w //Start w
//# (primes,w) = get_start_rule_as_expression "infprimes.bc" w //# (Just primes,w) = get_start_rule_as_expression (IF_WINDOWS "CodeSharing.exe" "CodeSharing") "infprimes.bc" w
//= last (iter 10 reverse [0..last (reverse (reverse (take 2000 primes)))]) //= last (iter 10 reverse [0..last (reverse (reverse (take 2000 primes)))])
// Example: get a function from a bytecode file and apply it // Example: get a function from a bytecode file and apply it
Start w Start w
# ((intsquare,sub5,sub3_10,sumints,rev,foldr,ap1,ap3,map,repeat,internal_types),w) # (Just (intsquare,sub5,sub3_10,sumints,rev,foldr,ap1,ap3,map,repeat,internal_types),w)
= get_start_rule_as_expression defaultDeserializationSettings "functions.bc" w = get_start_rule_as_expression defaultDeserializationSettings (IF_WINDOWS "CodeSharing.exe" "CodeSharing") "functions.bc" w
= (use intsquare sub5 sub3_10 sumints rev foldr ap1 ap3 map repeat, internal_types) = (use intsquare sub5 sub3_10 sumints rev foldr ap1 ap3 map repeat, internal_types)
where where
use :: use ::
......
module GraphTest module GraphTest
import StdEnv import StdEnv
import StdMaybe
from Data.Func import hyperstrict from Data.Func import hyperstrict
import System.OS import System.OS
...@@ -9,7 +10,10 @@ import ABC.Interpreter ...@@ -9,7 +10,10 @@ import ABC.Interpreter
Start w Start w
# (graph,w) = serialize_for_interpretation graph "GraphTest.bc" w # (graph,w) = serialize_for_interpretation graph "GraphTest.bc" w
# ((intsquare,sub5,sub3_10,sumints,rev,foldr,ap1,ap3,map,reverse_string,reverse_array,reverse_boxed_array,reverse_recarr,recarr,toInt_rec,sumtup),w) = deserialize defaultDeserializationSettings graph (IF_WINDOWS "GraphTest.exe" "GraphTest") w # graph = case graph of
Nothing -> abort "Could not serialize the graph; is GraphTest.bc up to date?\n"
Just g -> g
# (Just (intsquare,sub5,sub3_10,sumints,rev,foldr,ap1,ap3,map,reverse_string,reverse_array,reverse_boxed_array,reverse_recarr,recarr,toInt_rec,sumtup),w) = deserialize defaultDeserializationSettings graph (IF_WINDOWS "GraphTest.exe" "GraphTest") w
= use intsquare sub5 sub3_10 sumints rev foldr ap1 ap3 map reverse_string reverse_array reverse_boxed_array reverse_recarr recarr toInt_rec sumtup = use intsquare sub5 sub3_10 sumints rev foldr ap1 ap3 map reverse_string reverse_array reverse_boxed_array reverse_recarr recarr toInt_rec sumtup
where where
use :: use ::
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment