diff options
| -rw-r--r-- | snug-clean/src/Snug/Compile.icl | 1 | ||||
| -rw-r--r-- | snug-clean/src/Snug/Compile/Simulate.icl | 11 | ||||
| -rw-r--r-- | tests.snug | 18 |
3 files changed, 28 insertions, 2 deletions
diff --git a/snug-clean/src/Snug/Compile.icl b/snug-clean/src/Snug/Compile.icl index dcbc5ad..1bb7ff7 100644 --- a/snug-clean/src/Snug/Compile.icl +++ b/snug-clean/src/Snug/Compile.icl @@ -204,6 +204,7 @@ where simulator _ _ _ _ = // TODO pushBasicValue (BVInt 0) >>| buildCons (constructorLabel "" "INT") 1 +// = BasicValue !BasicValue // | Symbol !SymbolIdent // | Constructor !ConstructorIdent // | Case !Expression ![CaseAlternative] diff --git a/snug-clean/src/Snug/Compile/Simulate.icl b/snug-clean/src/Snug/Compile/Simulate.icl index af72277..b443913 100644 --- a/snug-clean/src/Snug/Compile/Simulate.icl +++ b/snug-clean/src/Snug/Compile/Simulate.icl @@ -130,14 +130,21 @@ indirectAndEval = , StoreWord TempImm 0 FrontEvalPtr ] >>| storeStackValue sv 4 FrontEvalPtr >>| + getState >>= \{hp_offset} -> add // Evaluate [ AddImmediate Signed FrontEvalPtr HeapPtr (Immediate offset) , Jump NoLink (Direct (Address 0 "eval")) - ] >>| + , AddImmediate Signed HeapPtr HeapPtr (Immediate hp_offset) + ] + SVIndirect 4 FrontEvalPtr -> + // We only need to overwrite the descriptor with an indirection getState >>= \{hp_offset} -> add - [ AddImmediate Signed HeapPtr HeapPtr (Immediate hp_offset) + [ LoadAddress TempImm (Address 0 (functionLabel "" NodeEntry "indir")) + , StoreWord TempImm 0 FrontEvalPtr + , Jump NoLink (Direct (Address 0 "eval")) + , AddImmediate Signed HeapPtr HeapPtr (Immediate hp_offset) ] _ -> fail "unexpected top of stack in indirect\n" @@ -6,3 +6,21 @@ (Tuple a b))) (test "printing tuples" : Tuple Int Int : (Tuple 1 2) "(1,2)") + +(fun id ((x : Int)) : Int : + x) +(fun const ((x : Int) (y : Int)) : Int : + x) +(fun tuple ((x : Int) (y : Int)) : Tuple Int Int : + Tuple x y) +(fun swapped_tuple ((x : Int) (y : Int)) : Tuple Int Int : + Tuple y x) + +(test "function application (id)" : Int : (id 1) "1") +(test "function application (id)" : Int : (id (id 2)) "2") +(test "function application (id)" : Int : (id (id (id 3))) "3") +(test "function application (const)" : Int : (const 1 2) "1") +(test "function application (const)" : Int : (const (const 1 2) 3) "1") +(test "function application (const)" : Int : (const 1 (const 2 3)) "1") +(test "function application (tuple)" : Tuple Int Int : (tuple 10 20) "(10,20)") +(test "function application (swapped_tuple)" : Tuple Int Int : (swapped_tuple 10 20) "(20,10)") |